perm filename TEST2.SAI[GEO,BGB]1 blob
sn#013174 filedate 1972-11-18 generic text, type T, neo UTF8
00100 BEGIN "TEST"
00200 REQUIRE "ABBREV" SOURCE_FILE;
00300 REQUIRE "DPYIII" SOURCE_FILE;
00400 REQUIRE "DPYIII" LOAD_MODULE;
00500 SAFE INTEGER ARRAY RAN5[0:255];
00600 INTEGER RAN1,RAN2,RAN3,RAN4,INITFLG;
00700 PROCEDURE RANDOMI;
00800 BEGIN "INIT"
00900 INTEGER I;
01000 RAN1←1;
01100 RAN2←3;
01200 FOR I←0 STEP 1 UNTIL 255 DO
01300 RAN5[I]←RAN2←(RAN2*3)MOD 2↑31 ;
01400 INITFLG ← TRUE;
01500 END "INIT";
01600
01700 INTERNAL REAL PROCEDURE RANDOM;
01800 BEGIN "RANDOM"
01900 IF INITFLG THEN ELSE RANDOMI;
02000 RAN1←(RAN2*1756) MOD 8191;
02100 RAN3←RAN1 DIV 32;
02200 RAN4←RAN5[RAN3];
02300 RAN2←RAN5[RAN3]←(RAN2*3)MOD 2↑31;
02400 RETURN(RAN4/2↑31)
02500 END "RANDOM";
00100 α DECLARATIONS;
00200 REAL A,B,C,Q;
00300 REAL X,Y; INTEGER IX,IY,I,J;
00400 SAFE ITG ARRAY DPYBUF[0:400];
00500 SAFE ITG ARRAY ZZZ[0:200];
00600 SAFE REAL ARRAY XXX[0:200];
00700 SAFE REAL ARRAY YYY[0:200];
00800 REAL SX,XX,XY,SY,YY;
00850 REAL W;
00900
00925 FOR I←1 TO 30 DO OUTSTR(↓);
00937 WHILE TRUE DO
00950 FOR W ← 0.0 STEP 0.02 UNTIL 1.1 DO
00975 BEGIN "BIG"
01000 α DISPLAY INITIALIZATION;
01100 DPYSET(DPYBUF); AIVECT(-500,-500);
01200 AVECT(+500,-500); AVECT(+500,+500);
01300 AVECT(-500,+500); AVECT(-500,-500);
01400
01500 AIVECT(-500,0);AVECT(+500,0);
01600 AIVECT(0,-500);AVECT(0,+500);
01700
01800 AIVECT(-400,-400);
01900 AVECT(+400,-400); AVECT(+400,+400);
02000 AVECT(-400,+400); AVECT(-400,-400);
02100
02200 SX←SY←XX←YY←XY←0; J←0;
00100 J ← 0;
00200 FOR X ← -1 STEP 0.02 UNTIL +1.01 DO
00300 BEGIN
00400 Y ← 0.3*X + 0.1;
00500 IF X=-1 THEN AIVECT(X*400,Y*350) ELSE AVECT(X*400,Y*350);
00600 XXX[J] ← X + W*(RANDOM-0.5);
00700 YYY[J] ← Y + W*(RANDOM-0.5);
00800
00900 SX ← SX + XXX[J];
01000 SY ← SY + YYY[J];
01100 XY ← XY + XXX[J]*YYY[J];
01200 XX ← XX + XXX[J]*XXX[J];
01300 YY ← YY + YYY[J]*YYY[J];
01400 J←J+1;
01500 END;
00100 FOR I←0 TO J-1 DO
00200 ⊂ AIVECT(XXX[I]*400-12,YYY[I]*350-9);DPYSST("o");⊃;
00300
00400 A ← J*XY-SX*SY;
00500 B ← SX*SX-J*XX;
00600 C ← SY*XX-XY*SX;
00700
00800 C ← -C/B; A ← -A/B;
00900 AIVECT(-400,350*(C-A));
01000 AVECT(+400,350*(C+A));
01100
01200 A ← SY*SY-J*YY;
01300 B ← J*XY - SY*SX;
01400 C ← SX*YY - XY*SY;
01500
01600 C ← -C/B; A ← -A/B;
01700 AIVECT(-400,350*(C-A));
01800 AVECT(+400,350*(C+A));
01900
02000 Q ← J*XY - SY*SX;
02100 A ← Q + SY*SY - J*YY;
02200 B ← Q + SX*SX - J*XX;
02300 C ← SX*YY + SY*XX - XY*(SX+SY);
02400
02500 C ← -C/B; A ← -A/B;
02600 AIVECT(-400,350*(C-A));
02700 AVECT(+400,350*(C+A));
00100 DPYOUT(0);
00300 α INCHRW;
00350 END "BIG";
00400 END;